home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / examples / xaw / popup < prev    next >
Encoding:
Text File  |  1991-09-26  |  1.0 KB  |  36 lines
  1. ;;; -*-Scheme-*-
  2. ;;;
  3. ;;; Popup menu demo
  4.  
  5. (require 'xwidgets)
  6. (load-widgets shell simplemenu smebsb label)
  7.  
  8. (define top (application-initialize 'popup))
  9.  
  10. (define l (create-managed-widget (find-class 'label) top))
  11. (set-values! l 'label "Press left button")
  12. (augment-translations l
  13.   "<Btn1Down>: XawPositionSimpleMenu(the-menu) MenuPopup(the-menu)")
  14.  
  15. ;; Due to a bug in the X11R5 SimpleMenu widget the `label' resource
  16. ;; can only be set at widget creation time:
  17. ;;
  18. (define menu (create-popup-shell 'the-menu (find-class 'simplemenu) l
  19.   'label 'menu))
  20.  
  21. (define (selected _)
  22.   (print (widget-name (simplemenu-get-active-entry menu))))
  23.  
  24. (define entries (map
  25.   (lambda (e)
  26.     (create-managed-widget e (find-class 'smebsb) menu 'vert-space 40
  27.                            'label e 'callback (list selected)))
  28.   '("hamburger" "fishburger" "pommes frites" "chicken nuggets" "chicken wings"
  29.     "milk shake")))
  30.  
  31. ; (set-values! menu 'popup-on-entry (cadr entries) 'label 'menu
  32. ;   'menu-on-screen #t)
  33.  
  34. (realize-widget top)
  35. (context-main-loop (widget-context top))
  36.